unit RclLog;

interface

uses Classes, SysUtils, LogLab;

type
  ELogException = class(Exception)
  end;

  TRclLog = class;

  TRclLogVendor = class(TObject)
  private
  protected
    function GetInstance(AName: string): ILog; overload; virtual; abstract;
  public
    destructor Destroy; override;
    procedure Config(AConfigFile: string); virtual; abstract;
    function Description: string; virtual; abstract;
    function GetLog(AClass: TClass): ILog; overload;
    function GetLog(AObject: TObject): ILog; overload;
    function GetLog(AName: string): ILog; overload;
  end;

  TRclLog = class(TInterfacedObject, ILog)
  protected
    FName: string;
    
    function FormatMsg(AMsg: string): string;
    function InternalIsDebugEnabled: Boolean; virtual; abstract;
    function InternalIsErrorEnabled: Boolean; virtual; abstract;
    function InternalIsFatalEnabled: Boolean; virtual; abstract;
    function InternalIsInfoEnabled: Boolean; virtual; abstract;
    function InternalIsTraceEnabled: Boolean; virtual; abstract;
    function InternalIsWarnEnabled: Boolean; virtual; abstract;
    procedure InternalDebug(const AMsg : String); virtual; abstract;
    procedure InternalError(const AMsg : String); virtual; abstract;
    procedure InternalFatal(const AMsg : String); virtual; abstract;
    procedure InternalInfo(const AMsg : String); virtual; abstract;
    procedure InternalTrace(AMsg: string); virtual; abstract;
    procedure InternalWarn(const AMsg : String); virtual; abstract;
  public
    destructor Destroy; override;
    procedure Debug(const AMsg : String);
    procedure Error(const AMsg : String);
    procedure Fatal(const AMsg : String);
    procedure Info(const AMsg : String);
    function IsDebugEnabled: Boolean;
    function IsErrorEnabled: Boolean;
    function IsFatalEnabled: Boolean;
    function IsInfoEnabled: Boolean;
    function IsTraceEnabled: Boolean;
    function IsWarnEnabled: Boolean;
    procedure Trace(AMsg: string);
    procedure Warn(const AMsg : String);
    function GetName: string; stdcall;
  end;

  procedure RegisterLogVendor(Vendor: TRclLogVendor);

  procedure UnregisterLogVendor(Vendor: TRclLogVendor);

  procedure ListLogVendors(List: TStrings);

  function GetLogVendor(Name: string = ''): TRclLogVendor;

resourcestring    
  SUnknownVendor = 'Unknown Log Vendor %s';

var
  DefaultLogVendor: string;
  PackageName: string = 'Rcl';

implementation

var
  LogVendors: TStringList;

procedure RegisterLogVendor(Vendor: TRclLogVendor);
var
  Index: Integer;
begin
  Index := LogVendors.IndexOf(Vendor.Description);
  if Index = -1 then
    LogVendors.AddObject(Vendor.Description, Vendor)
  else
  begin
    LogVendors.Objects[Index].Free;
    LogVendors.Objects[Index]:= Vendor;
  end;
end;

procedure UnregisterLogVendor(Vendor: TRclLogVendor);
var
  Index: Integer;
begin
  Index := LogVendors.IndexOf(Vendor.Description);
  if Index > -1 then
  begin
    LogVendors.Objects[Index].Free;
    LogVendors.Delete(Index);
  end;
end;

procedure ListLogVendors(List: TStrings);
var
  Index: Integer;
begin
  List.Clear;
  for Index := 0 to LogVendors.Count - 1 do
    List.AddObject(LogVendors[Index], LogVendors.Objects[Index]); 
end;

function GetLogVendor(Name: string = ''): TRclLogVendor;
var
  Index: Integer;
begin
  if Name = '' then
    Name := DefaultLogVendor;
  Index := LogVendors.IndexOf(Name);
  if Index = -1 then
    raise ELogException.CreateFmt(sUnknownVendor, [Name])
  else
    Result := TRclLogVendor(LogVendors.Objects[Index]);
end;

procedure ClearVendors;
var
  Index: Integer;
begin
  for Index := 0 to LogVendors.Count - 1 do
    LogVendors.Objects[Index].Free;
end;

destructor TRclLog.Destroy;
begin
  inherited;
  // TODO -cMM: TRclLog.Destroy default body inserted
end;

procedure TRclLog.Debug(const AMsg : String);
begin
//  if FParent <> nil then
//    FParent.Debug(AMsg)
//  else
    Self.InternalDebug(AMsg);
end;

procedure TRclLog.Error(const AMsg : String);
begin
//  if FParent <> nil then
//    FParent.Error(AMsg)
//  else
    Self.InternalError(AMsg);
end;

procedure TRclLog.Fatal(const AMsg : String);
begin
//  if FParent <> nil then
//    FParent.Fatal(AMsg)
//  else
    Self.InternalFatal(AMsg);
end;

function TRclLog.FormatMsg(AMsg: string): string;
begin
  Result := FName + ': ' + AMsg;
end;

function TRclLog.GetName: string;
begin
  Result := FName;
end;

procedure TRclLog.Info(const AMsg : String);
begin
//  if FParent <> nil then
//    FParent.Info(AMsg)
//  else
    Self.InternalInfo(AMsg);
end;

function TRclLog.IsDebugEnabled: Boolean;
begin
//  if FParent <> nil then
//    Result := FParent.IsDebugEnabled
//  else
    Result := Self.InternalIsDebugEnabled;
end;

function TRclLog.IsErrorEnabled: Boolean;
begin
//  if FParent <> nil then
//    Result := FParent.IsErrorEnabled
//  else
    Result := Self.InternalIsErrorEnabled;
end;

function TRclLog.IsFatalEnabled: Boolean;
begin
//  if FParent <> nil then
//    Result := FParent.IsFatalEnabled
//  else
    Result := Self.InternalIsFatalEnabled;
end;

function TRclLog.IsInfoEnabled: Boolean;
begin
//  if FParent <> nil then
//    Result := FParent.IsInfoEnabled
//  else
    Result := Self.InternalIsInfoEnabled;
end;

function TRclLog.IsTraceEnabled: Boolean;
begin
//  if FParent <> nil then
//    Result := FParent.IsTraceEnabled
//  else
    Result := Self.InternalIsTraceEnabled;
end;

function TRclLog.IsWarnEnabled: Boolean;
begin
//  if FParent <> nil then
//    Result := FParent.IsWarnEnabled
//  else
    Result := Self.InternalIsWarnEnabled;
end;

procedure TRclLog.Trace(AMsg: string);
begin
//  if FParent <> nil then
//    FParent.trace(AMsg)
//  else
    Self.Internaltrace(AMsg);
end;

procedure TRclLog.Warn(const AMsg : String);
begin
//  if FParent <> nil then
//    FParent.Warn(AMsg)
//  else
    Self.InternalWarn(AMsg);
end;

destructor TRclLogVendor.Destroy;
begin
  
  inherited;
end;

function TRclLogVendor.GetLog(AClass: TClass): ILog;
begin
  if AClass <> nil then
    Result := GetLog(AClass.ClassName);
end;

function TRclLogVendor.GetLog(AObject: TObject): ILog;
begin
  if AObject <> nil then
    Result := GetLog(AObject.ClassName);
end;

function TRclLogVendor.GetLog(AName: string): ILog;
begin
  Result := getInstance(PackageName + '.' + AName);
end;

initialization
  LogVendors := TStringList.Create;

finalization
  ClearVendors;
  LogVendors.Free;

end.
